perm filename UTILTY.FAI[CEL,BGB] blob
sn#131894 filedate 1974-11-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00026 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE UTILTY - UTILITY ROUTINES - BRUCE G. BAUMGART - MAY 1974.
C00005 00003 TITLE ARITH - ARITHMETIC ROUTINES.
C00008 00004 SUBR(SIN)
C00010 00005 SUBR(ATAN,X) ARC TANGENT
C00013 00006 SUBR(ATAN2,DY,DX) ARC TANGENT (DELTA-Y,DELTA-X)
C00016 00007 SUBR(REALI)
C00018 00008 PRIMARY:
C00021 00009 TITLE III - III DISPLAY SUBROUTINES - BGB - JANUARY 1973.
C00022 00010 SUBR(DPYSET,BUFFER) INITIALIZE A DISPLAY BUFFER.
C00024 00011 SUBRS AVECT,AIVECT,RVECT,RIVECT Vectors
C00026 00012 SUBR(DPYSTR,TEXT)
C00029 00013 SUBRS OCTDPY,DECDPY,FLODPY Numeric display
C00032 00014 TITLE MEMORY MANAGEMENT - BGB - FEBRUARY 1974.
C00033 00015 SAIL COMPATIBLITY ROUTINES.
C00035 00016 LISP COMPATIBLITY ROUTINES.
C00037 00017 SUBR(MKUNIV) MAKE UNIVERSE.
C00040 00018 SUBR(MKCAMERA,WORLD)
C00042 00019 SUBR(MKWINDOW,CAMERA,WINDOW) MAKE AND LINK A WINDOW NODE.
C00044 00020 FAIL MORE CORE.
C00046 00021 SAIL MORE CORE.
C00049 00022 SUBR(MKNODE,NODTYP) ALLOCATE A BLOCK OF NODSIZ WORDS.
C00051 00023 TITLE IO - INPUT/OUTPUT - BGB - FEBRUARY 1973.
C00054 00024 SUBR(PLOTO)SAISTR DISPLAY BUFFER TO DISK FILE.
C00055 00025 SUBN(GETFIL,EXT) SETUP FILE SPEC FROM TTY LINE.
C00061 00026 SUBR(GETCHW) GET CHARACTER WAIT.
C00065 ENDMK
C⊗;
TITLE UTILTY - UTILITY ROUTINES - BRUCE G. BAUMGART - MAY 1974.
.INSERT MN
FATAL.↑:
OUTSTR[ASCIZ/FATAL: /]
LAC 0,@1(P)
OUTSTR @0
CRLF
HALT
;TITLE ARITH - ARITHMETIC ROUTINES.
HALFPI↑: 201622077325 ;PI/2
PI↑: 202622077325 ;PI
TWOPI↑: 203622077325 ;2*PI
SUBR(SQRT,X) ;SQUARE ROOT OF ABS(X).
COMMENT .-----------------------------------------------------------.
A←←0 ↔ B←←1 ↔ C←←2
MOVM B,X↔JUMPE B,POP1J.↔PUSHP 2
;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
ASHC B,-=27↔SUBI B,201 ;GET EXPONENT IN B, FRACTION IN C.
ROT B,-1 ;CUT EXP IN HALF, SAVE ODD BIT
DAP B,L↔LSH B,-=35 ;USE THAT ODD BIT.
ASH C,-10↔FSC C,177(B) ;0.25 < FRACTION < 1.00
;LINEAR APPROXIMATION TO SQRT(F).
DAC C,A
FMP C,[0.8125↔0.578125](B)
FAD C,[0.302734↔0.421875](B)
;TWO ITERATIONS OF NEWTON'S METHOD.
LAC B,A
FDV B,C↔FAD C,B↔FSC C,-1
FDV A,C↔FADR A,C
L: FSC A,0↔LAC 1,A↔POPP 2
POP1J
ENDR SQRT; BGB 28 DECEMBER 1972 -------------------------------------
SUBR(LOG,X) ;NATURAL LOGRITHM.
COMMENT .-----------------------------------------------------------.
MOVM X↔SKIPE 1,0↔CAMN 0,[1.0]↔POP1J
ASHC 0,-33↔ADDI 0,211000↔MOVSM 0,TMP1#
MOVSI 0,(-128.5)↔FADM 0,TMP1
ASH 1,-10↔TLC 1,200000↔FAD 1,[-0.70710678]
LAC 0,1↔FAD 0,[1.4142135]↔FDV 1,0
DAC 1,TMP2#↔FMP 1,1
LAC 0,[0.59897864]↔FMP 0,1
FAD 0,[0.96147063]↔FMP 0,1
FAD 0,[2.88539120]↔FMP 0,TMP2↔FAD 0,TMP1
FMP 0,[0.69314718]↔LAC 1,0↔POP1J
VAR
ENDR LOG;---------------------------------------------------------
SUBR(SIN)
GO SIN.↔ENDR SIN
SUBR(COS)
GO COS.↔ENDR COS
BEGIN SINCOS ;MODIFIED OLDE LIB40 SINE & COSINE - BGB.
A←←1 ↔ B←←2 ↔ C←←3
↑COS.: SKIPA A,-1(P)
↑SIN.: SKIPA A,-1(P)
FADR A,HALFPI ;COS(X) = SIN(X+π/2).
MOVM B,A↔CAMG B,[17B5]↔POP1J ;FOR SMALL X, SIN(X)=X.
;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
FDVR B,HALFPI
LAC C,B↔FIX C,233000
CAILE C,3↔GO[
TRZ C,3↔FSC C,233
FSBR B,C↔GO .-3] ;MODULO 2π.
GO .+1(C)↔GO .+4↔JFCL↔GO[
FSBRI B,(2.0)↔MOVNS B↔GO .+2] ;SIN(X+π)=SIN(-X)
FSBRI B,(4.0) ;SIN(X+2π)=SIN(X)
SKIPGE A↔MOVNS B ;SIN(-X) = -SIN(X).
;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
DAC B,C↔FMPR B,B
LAC A,[164475536722]↔FMP A,B
FAD A,[606315546346]↔FMP A,B
FAD A,[175506321276]↔FMP A,B
FAD A,[577265210372]↔FMP A,B
FAD A,HALFPI↔FMPR A,C↔POP1J
LIT
BEND SINCOS;---------------------------------------------------------
SUBR(ATAN,X) ;ARC TANGENT
COMMENT ⊗------------------------------------------------------------
IF 0.0 < X ≤ 1.0 THEN ⊂ Z ← X*X;
RETURN (ATAN(X) = X*(B0+A1/(Z+B1-A2/(Z+B2-A3/(Z+B3)))));⊃;
IF X>1 THEN ATAN(X) = PI/2 - ATAN(1/X);
IF X>1 THEN RH(D) =-1, AND LH(D) = -SGN(X)
IF X<1, THEN RH(D) = 0, AND LH(D) = SGN(X)
⊗
A←←1 ↔ B←←2 ↔ C←←3 ↔ D←←4 ↔ E←←5
LAC A,X ;PICK UP THE ARGUMENT IN A
ATAN1: MOVM B, A ;GET ABSF OF ARGUMENT
CAMG B, A1 ;IF X<2↑-33, THEN RETURN WITH...
POP1J ;ATAN(X) = X
HLLO D, A ;SAVE SIGN, SET RH(D) = -1
CAML B, A2 ;IF A>2↑33, THEN RETURN WITH
GO[LAC A,HALFPI ↔POP1J]; ATAN(X) = PI/2
MOVSI C,(<1.0>) ;FORM 1.0 IN C
CAMG B, C ;IS ABSF(X)>1.0?
TRZA D, -1 ;IF B ≤ 1.0, THEN RH(D) = 0
FDVM C, B ;B IS REPLACED BY 1.0/B
TLC D, (D) ;XOR SIGN WITH > 1.0 INDICATOR
DAC B,E↔FMP B,B
LAC C,B↔FAD C,KB3↔LAC A,KA3↔FDVM A,C
FAD C,B↔FAD C,KB2↔LAC A,KA2↔FDVM A,C
FAD C,B↔FAD C,KB1↔LAC A,KA1↔FDV A,C
FAD A,KB0↔FMP A,E
TRNE D, -1 ;CHECK > 1.0 INDICATOR
FSB A, HALFPI ;ATAN(A) = -(ATAN(1/A)-PI/2)
SKIPGE D ;LH(D) = -SGN(B) IF B>1.0
MOVNS A ;NEGATE ANSWER
POP1J ;EXIT
A1: 145000000000 ;2↑-33
A2: 233000000000 ;2↑33
KB0: 176545543401 ;0.1746554388
KB1: 203660615617 ;6.762139240
KB2: 202650373270 ;3.316335425
KB3: 201562663021 ;1.448631538
KA1: 202732621643 ;3.709256262
KA2: 574071125540 ;-7.106760045
KA3: 600360700773 ;-0.2647686202
ENDR ATAN;--------------------------------------------------------
SUBR(ATAN2,DY,DX) ;ARC TANGENT (DELTA-Y,DELTA-X)
COMMENT .-----------------------------------------------------------.
; OMEGA ← ATAN2(Y,X).
Y←←1 ↔ X←←2
MOVM Y,DY↔MOVM X,DX
CAMN X,Y↔JUMPE Y,L2
CAML Y,X↔GO L1
;HORIZONTAL TO π/2; ABS(Y) < ABS(X).
LAC Y,DY↔FDVR Y,DX
PUSH 17,Y↔PUSHJ 17,ATAN ;ARCTAN(Y/X)
SKIPL DX↔POP2J ;1ST & 2ND QUADRANTS.
JUMPGE Y,[
FSBR Y,PI↔POP2J] ;3RD QUADRANT.
FADR Y,PI↔POP2J ;2ND QUADRANT.
;VERTICAL TO π/2; ABS(X) < ABS(Y).
L1: MOVN X,DX↔FDVR X,DY
PUSH 17,X↔PUSHJ 17,ATAN ;ARCTAN(X/Y)
SKIPG DY↔GO[
FSB Y,HALFPI↔POP2J]
FADR Y,HALFPI
L2: POP2J
ENDR ATAN2;----------------------------------------------------------
SUBR(ASIN,X) ;ARC SINE.
COMMENT .-----------------------------------------------------------.
; ASIN(X)=ATAN(X/SQRT(1-X↑2)).
; GIVEN -1 ≤ X ≤ +1 RETURN -π/2 ≤ ASIN(X) ≤ +π/2.
A←1 ↔ B←2
MOVN A,X↔FMPR A,X↔FADRI A,(1.0)
JUMPE A,[LAC A,HALFPI ;WAS X EITHER -1.0 OR 1.0?
SKIPGE X↔MOVNS A↔POP1J]
CALL(SQRT,A)
LAC B,X↔FDVR B,1↔DAC B,X ;CALCULATE X/SQRT(1-X↑2)
EX. ;To fix over-AOSing ENTERS
GO ATAN ;CALCULATE ATAN(SQRT(1-X↑2))
ENDR ASIN;-----------------------------------------------------------
SUBR(ACOS,X) ;ARC COSINE.
COMMENT .-----------------------------------------------------------.
; ACOS(X)= π/2 - ASIN(X).
; GIVEN -1 ≤ X ≤ +1 RETURN 0 ≤ ACOS(X) ≤ +π.
CALL(ASIN,X)
MOVNS 1↔FADR 1,HALFPI
POP1J
ENDR ACOS;--------------------------------------------------------
SUBR(REALI)
COMMENT ⊗------------------------------------------------------------
<EXPR> ::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
<TERM> ::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
<PRIMARY> ::= -<PRIMARY>|(<EXPR>)|π|<REAL NUMBER> ⊗
REAL0: CALL(TERM)
REAL1: CAIN 1,"+"↔GO[PUSH P,0
CALL(TERM)↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REAL1]
CAIN 1,"-"↔GO[PUSH P,0
CALL(TERM)↔MOVN 0,0
FADR 0,(P)
SUB P,[XWD 1,1]↔GO REAL1]
CAIN 1,15↔CALL(GETCHL) ;CARRIAGE RETURN - LINE FEED.
POP0J
;--------------------------------------------------------------------
TERM: CALL(PRIMARY)
TERM2: CAIN 1,"*"↔GO[PUSH P,0
CALL(PRIMARY)↔FMPR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2 ]
CAIN 1,"/"↔GO[PUSH P,0
CALL(PRIMARY)↔EXCH 0,(P)
FDVR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2 ]
POPJ P,
;--------------------------------------------------------------------
PRIMARY:
BEGIN PRIMARY;-------------------------------------------------------
ITG ←← 0 ;INTEGER ACCUMULATION. AC-0 RETURNS REAL NUMBER
CHR ←← 1 ;CHARACTER JUST SCANNED. AC-1 RETURNS BREAK CHR.
CNT ←← 2 ;COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT +1.
FLG ←← 3 ;MINUS SIGN FLAG.
SETZ ITG↔SETZB CNT,FLG ;INITIALIZATION.
L0: CALL(GETCHL) ;FIRST CHARACTER.
CAIN 1," "↔GO L0 ;LEADING BLANKS.
CAIN 1,"-"↔GO[SETCMM 3↔GO L0] ;UNARY MINUS SIGNS.
CAIN 1,"π"↔GO[LAC 0,PI↔GO L3] ;PI
CAIN 1,"("↔GO[PUSH P,FLG↔CALL(REALI)↔POP P,FLG ;PARENTHESES
CAIN 1,")"↔GO L3
OUTSTR[ASCIZ/WARNING: MISSING ')'/]↔CRLF
POPJ P,]
SKIPA
L1: CALL(GETCHL)
CAIE CHR,"."↔GO .+3
JUMPN CNT,L2 ;EXIT IF THIS IS A 2ND DECIMAL POINT.
AOJA CNT,L1 ;BEGIN COUNT OF DIGITS TO RIGHT OF DECIMAL POINT.
CAIL CHR,"0"↔CAILE CHR,"9"↔GO L2 ;DIGITS FALL THRU.
TLNE 777000↔GO L1 ;27-BIT MANTISSA IS ENOUGH.
SKIPE CNT↔AOS CNT ;COUNT DIGITS RIGHT OF DECIMAL.
ANDI 1,17↔IMULI =10↔ADD 1↔GO L1 ;ACCUMULATE A DIGIT.
L2: TLNE 777000↔GO[LSH -3↔FLOAT↔FSC 3↔GO .+2]
FLOAT↔CAIL CNT,2
FDVR[1E1↔1E2↔1E3↔1E4↔1E5↔1E6↔1E7↔1E8↔1E9↔1E10]-2(2) ;SCALE MANTISSA.
CAIN CHR,42↔GO[FDVR[12.0]↔GO L3] ;INCHES ?
CAIN CHR,"`"↔GO[FMPR[1.74532925E-2]↔GO L3] ;DEGREES ?
CAIN CHR,"'"↔GO[FMPR[2.90888208E-4]↔GO L3] ;MINUTES OF ARC ?
SKIPA
L3: CALL(GETCHL)
SKIPE 3↔MOVNS ;SIGNED.
POPJ P,
BEND PRIMARY
ENDR REALI;12/16/72(BGB),14-MAR-73(TVR)------------------------------
;TITLE III - III DISPLAY SUBROUTINES - BGB - JANUARY 1973.
BUFDPY↑: .+2↔=250
BLOCK =260
DPYBUF↑:DPYBU.↔=6000
DPYBU.: BLOCK =6000
IGNORE: 0
SIZBRT: 0
DPYCOL: 0
DPYPTR↑: 0
BUFEND: 0
BUFHD: 0↔0 ;UPG ARGUMENT. ;ADDRESS ↔ LENGTH.
;VERNIER III TEXT POSITIONING.
VERNX ←← 14
VERNY ←← 11
;DISPLAY SAIL STRING.
DPYSST↑: POP 16,1↔POP 16,2↔SKIPGE IGNORE↔POPJ P,
HRRZS 2 ;LENGTH OF STRING.
JUMPLE 2,SSRET
ILDB 3,1
IDPB 3,DPYPTR
SOJG 2,.-2
SSRET: HRRZ 1,DPYPTR
CAML 1,BUFEND
SETOM IGNORE
POPJ P,
SUBR(DPYSET,BUFFER) ;INITIALIZE A DISPLAY BUFFER.
COMMENT .-----------------------------------------------------------.
A←←1
ACCUMULATORS{B,C}
LAC 1,BUFFER↔CDR 2,-1(1) ;BUFFER SIZE.
ADDI 2,-1(1)↔DAC 2,BUFEND
ADDI 1,2↔DAC 1,BUFHD ;POINT TO THIRD WORD.
SETZM IGNORE
SETZM SIZBRT
CLR2: LAC A,BUFHD ;BLIT III-TEXT OPCODE-1 THRU THE BUFFER.
MOVEI B,1↔DAC B,1(A)
MOVEI B,2(A)↔HRLI B,1(A)
BLT B,@BUFEND
PUSH P,(P)↔GO LV3
ENDR DPYSET;---------------------------------------------------------
SUBR(DPYBIG,SIZE) ;SET CHARACTER SIZE.
COMMENT .-----------------------------------------------------------.
LAC SIZE
DPB [POINT 3,SIZBRT,27] ;REMEMBER NEW SIZE
POP1J
ENDR DPYBIG;---------------------------------------------------------
SUBR(DPYBRT,SIZE) ;SET BRIGHTNESS.
COMMENT .-----------------------------------------------------------.
LAC SIZE
DPB [POINT 3,SIZBRT,24] ;REMEMBER NEW BRIGHTNESS
POP1J
ENDR DPYBRT;---------------------------------------------------------
;SUBRS AVECT,AIVECT,RVECT,RIVECT ;Vectors
COMMENT ⊗
TEXT DISPLAY WORD: ASCII/ABCDE/ + 1
LONG VECTOR WORD: BYTE(11)X,Y(3)BRT,SIZ(7)OPCODE ⊗
SUBR(RIVECT)
GO RIV. ↔ENDR RIVECT
SUBR(RVECT)
GO RV. ↔ENDR RVECT
SUBR(AIVECT)
GO AIV. ↔ENDR AIVECT
SUBR(AVECT)
GO AV. ↔ENDR AVECT
;USES AC 1-3
;DTYO DEPENDS ON THIS
RIV.: SKIPA 3,[046] ;RELATIVE INVISIBLE VECTOR.
RV.: MOVEI 3, 006 ↔GO LV0 ;RELATIVE VISIBLE VECTOR.
AIV.: SKIPA 3,[146] ;ABSOLUTE INVISIBLE VECTOR.
AV.: MOVEI 3, 106 ;ABSOLUTE VISIBLE VECTOR.
SETZM DPYCOL ;RESET TAB LOCATION
LV0: SKIPGE IGNORE↔POP2J
LV: LAC 1,-2(P)↔LAC 2,-1(P) ;PICKUP X AND Y.
LVC: DPB 1,[POINT 11,3,10] ;PACK X INTO III-WORD.
DPB 2,[POINT 11,3,21] ;PACK Y INTO III-WORD.
SKIPE 1,SIZBRT ;NEW BRIGHTNESS OR SIZE?
GO [ IOR 3,1↔SETZM SIZBRT↔GO LV2] ;YES, SET IT
LV2: AOS 1,DPYPTR↔DAC 3,(1) ;PACK WORD INTO III-BUFFER.
LV3: HRLI 1,<(<POINT 7,0,35>)> ;UPDATE DPYPTR...
DAC 1,DPYPTR↔MOVEI 1,(1) ;WHICH IS A BYTE-POINTER.
CAML 1,BUFEND↔SETOM IGNORE ;CHECK FOR BUFFER OVERFLOW.
POP2J
SUBR(DPYSTR,TEXT)
COMMENT .-----------------------------------------------------------.
;USES AC 1,3
SKIPE IGNORE↔POP1J
LAC 3,TEXT↔HRLI 3,440700
L1: ILDB 3↔JUMPE POP1J.
CALL(DTYO,0)↔GO L1
ENDR DPYSTR;---------------------------------------------------------
SUBR(DTYO,CHAR)
COMMENT .-----------------------------------------------------------.
;USES AC 1
;DPYSTR DEPENDS ON DTYO NOT CLOBBERING 3
SKIPE IGNORE↔POP1J
SKIPE SIZBRT
GO [ PUSHP 0↔PUSHP 2↔PUSHP 3
CALL(RIVECT,[0],[0])
POPP 3↔POPP 2↔POPP 0
GO .+1]
LAC 1,CHAR
CAIN 1,15↔SETOM DPYCOL
CAIN 1,11↔GO DOTAB
DTYO1: IDPB 1,DPYPTR↔AOS DPYCOL
CDR 1,DPYPTR↔CAML 1,BUFEND
SETOM IGNORE↔POP1J
DOTAB: CALL(DTYO,[" "]) ;We got a tab, put out spaces until
LAC 1,DPYCOL ;column is divisible by 8
TRNE 1,7↔GO DOTAB
CDR 1,DPYPTR
POP1J
ENDR DTYO;-----------------------------------------------------------
SUBR(DPYOUT,POG)
COMMENT .-----------------------------------------------------------.
.LOAD SYS:NETDPY.REL
A←←1
ACCUMULATORS{B,C}
SKIPN A,BUFHD↔GO L1
LAC 2,DPYPTR↔DAC 2,-2(1)
MOVEI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
L1: CDR B,DPYPTR↔SUB B,BUFHD ;BUFFER LENGTH.
AOS B↔DAC B,BUFHD+1
MOVM A,POG↔DPB A,[POINT 4,UPGOP,12] ;GLASS TO AC FIELD.
PUSHJ P,NETDPY↑
XCT UPGOP
POP1J
UPGOP: 703B8+BUFHD
ENDR DPYOUT;---------------------------------------------------------
;SUBRS OCTDPY,DECDPY,FLODPY ;Numeric display
;--------------------------------------------------------------------
SUBR(OCTDPY,INTEGER) ;OCTAL NUMBER DISPLAY.
Q←15 ↔ N←13
JFCL↔GO L2
LAC 14,INTEGER↔LAC Q,[POINT 3,14,-1]↔MOVEI N,6
L1: ILDB Q↔IORI 60↔CALL(DTYO,0)↔SOJG N,L1
CALL(DTYO,[" "])
L2: LAC 14,INTEGER↔LAC Q,[POINT 3,14,17]↔MOVEI N,6
L3: ILDB Q↔IORI 60↔CALL(DTYO,0)↔SOJG N,L3
POP1J
ENDR OCTDPY;3/25/73(BGB)---------------------------------------------
DECDPY↑:;(INTEGER) ;DECIMAL NUMBER DISPLAY.
BEGIN DECDPY
LAC 1,-1(P)↔POP P,-1(P) ;FETCH ARG AND LAC RET. ADR.
L1: JUMPGE 1,L2 ;TEST FOR NEGATIVE NUMBER.
MOVM 2,1↔CALL(DTYO,["-"]) ;PRINT MINUS SIGN.
LAC 1,2
L2: IDIVI 1,12↔PUSH P,2 ;MODULO TEN AND SAVE.
SKIPE 1↔PUSHJ P,L2 ;TEST FOR DONE.
POP P,1↔ADDI 1,60↔CALL(DTYO,1) ;RESTORE & PRINT.
POPJ P,
BEND DECDPY;12/17/72(BGB)--------------------------------------------
SUBR(FLODPY,FLONUM,PLACES) ;FLOATING NUMBER DISPLAY.
LAC FLONUM
JUMPL[CALL(DTYO,["-"])↔MOVM FLONUM↔GO .+1]
MOVM 2,PLACES↔CAILE 2,6↔MOVEI 2,6↔DAC 2,PLACES
FMPR[1.↔10.↔100.↔1000.↔10000.↔100000.↔1000000.](2)↔FIXX
IDIV[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
PUSHP 1↔CALL(DECDPY,0)↔POPP 0
LAC 2,PLACES
ADD[=1↔=10↔=100↔=1000↔=10000↔=100000↔=1000000](2)
PUSHP DPYPTR↔CALL(DECDPY,0)↔POPP 1
MOVEI "."↔IDPB 0,1
POP2J
ENDR FLODPY;12/17/72(BGB)--------------------------------------------
;TITLE MEMORY MANAGEMENT - BGB - FEBRUARY 1974.
;UNIVERSE TOP STRUCTURE.
;--------------------------------------------------------------------
OLD44↑: 0 ;ORIGINAL JOBREL 44 CONTENTS.
UNIVER↑:0 ;POINTER TO UNIVERSE NODE.
BLKCNT↑:0 ;NUMBER OF NON EMPTY NODES.
AVAIL↑: 0 ;POINTER TO FIRST EMPTY NODE.
NODSIZ←←=12 ;NUMBER OF WORDS PER NODE.
MINLINK←←-3 ;LOWEST NUMBERED LINK.
REMAINDER:0 ;NUMBER OF UNUSED WORDS BETWEEN
; THE TOP OF NODE SPACE AND THE TOP OF CORE.
;--------------------------------------------------------------------
;SAIL COMPATIBLITY ROUTINES.
;--------------------------------------------------------------------
;SAIL ACCUMULATORS PROTECTED: 12,16,17.
IFN SAIL{
ENTRY.↑: 0 ;SAIL TO GEM.
DAC 12,SAIL12
DAC 16,SAIL16
GO@ENTRY.
EXIT.↑: 0 ;GEM TO SAIL.
DAC 1,RESULT↑ ;GLOBAL RESULT VALUE.
LAC 12,SAIL12
LAC 16,SAIL16
GO@EXIT.
SAIL12↑:0
SAIL16↑:0
ENTERS↑:-1
LIT}
;--------------------------------------------------------------------
IFN SAIL{
INTERN CAR,CDR,DIP,DAP
CAR: LAC 1,-1(P)↔CAR 1,(1)↔SUB P,[2(2)]↔GO@2(P)
CDR: LAC 1,-1(P)↔CDR 1,(1)↔SUB P,[2(2)]↔GO@2(P)
DIP: LAC -2(P)↔LAC 1,-1(P)↔DIP 0,(1)↔SUB P,[3(3)]↔GO@3(P)
DAP: LAC -2(P)↔LAC 1,-1(P)↔DAP 0,(1)↔SUB P,[3(3)]↔GO@3(P)
}
;LISP COMPATIBLITY ROUTINES.
;--------------------------------------------------------------------
;LISP ACCUMULATORS PROTECTED: 0,14,15,16,17.
IFN LISP{
DEFINE NUMVAL(AC){
TRNE AC,400000↔GO .+4
CDR AC,(AC)↔CDR AC,(AC)↔SKIPA AC,(AC)
SUBI AC,577777}
ENTRY.↑:0 ;LISP TO GEM.
DAC 0,LISP0↔LAC[XWD 5,LISP0+5]
BLT 0,LISP0+17↔LAC 17,14 ;USE LISP PDL.
CDR ENTRY.↔SUBI 3↔CAR@↔ANDI 7 ;NUMBER OF ARGUMENTS.
JUMPE @ENTRY.
NUMVAL(1)↔PUSH P,1↔SOSG↔PUSHJ P,@ENTRY.
NUMVAL(2)↔PUSH P,2↔SOSG↔PUSHJ P,@ENTRY.
NUMVAL(3)↔PUSH P,3↔SOSG↔PUSHJ P,@ENTRY.
NUMVAL(4)↔PUSH P,4↔SOSG↔PUSHJ P,@ENTRY.
SKIPA
EXIT.↑: 0 ;GEM TO LISP.
LAC 0,[XWD LISP0+5,5]↔BLT 0,17
LAC 0,LISP0
TLNE 1,-1↔GO MAKNUM↑ ;FLONUM.
GO MAKNUM+1 ;FIXNUM.
ENTERS↑: -1↔LISP0:BLOCK 20}
;--------------------------------------------------------------------
SUBR(MKUNIV) ;MAKE UNIVERSE.
COMMENT .-----------------------------------------------------------.
CALL(MORCOR) ;MAKE UNIVERSE NODE.
SETQ(WORLD,{MKWORLD}) ;MAKE A WORLD FOR THIS UNIVERSE.
SETQ(CAMERA,{MKCAMERA,WORLD}) ;MAKE A CAMERA FOR THIS WORLD.
CALL(MKWINDOW,CAMERA,[0]) ;MAKE A WINDOW FOR THIS CAMERA.
POP0J
DECLARE{WORLD,CAMERA}
ENDR MKUNIV;7/12/73(BGB)---------------------------------------------
SUBR(MKWORLD) ;MAKE A WORLD NODE.
COMMENT .-----------------------------------------------------------.
SETQ(WORLD#,{MKNODE,[$WORLD]})
CW. 1,1↔CCW. 1,1 ;EMPTY BODY RING.
BRO. 1,1↔SIS. 1,1 ;WORLD RING.
CALL(MKFRAME↑) ;WORLD FRAME OF REFERENCE.
LAC 2,WORLD
FRAME. 1,2
;PLACE NEW WORLD AT THE END OF THE WORLD RING.
LAC 1,WORLD
LAC 4,UNIVERSE↔PWRLD 2,4 ;GET FIRST WORLD OF THIS UNIVERSE.
JUMPN 2,[BRO 3,2
BRO. 1,2↔SIS. 2,1 ;RING-IN THE NEW WORLD.
SIS. 1,3↔BRO. 3,1↔GO .+3]
NWRLD. 1,4↔PWRLD. 1,4 ;INIT THE UNIVERSE'S WORLD RING.
;MAKE A SUN FOR THIS WORLD.
SETQ(SUN#,{MKCAMERA,[0]}) ;MAKE A SUN (LIKE A CAMERA).
MOVEI $SUN↔DAP(1) ;MARK THE NODE AS SUN TYPE.
FRAME 2,1↔LAC[100.0]↔DAC ZWC(2) ;PLACE SUN A HUNDRED FEET UP.
LAC 2,WORLD↔ALT. 1,2↔PWRLD. 2,1 ;PLACE THE SUN IN THE WORLD.
;RETURN WORLD.
LAC 1,WORLD↔POP0J
ENDR MKWORLD;3/12/73(BGB)--------------------------------------------
SUBR(MKCAMERA,WORLD)
COMMENT .------------------------------------------------------------
If WORLD argument is not zero then place camera in world's camera ring.
SETQ(CAMERA#,{MKNODE,[$CAMERA]})
BRO. 1,1↔SIS. 1,1 ;CAMERA RING.
SKIPE 2,WORLD↔PWRLD. 2,1 ;CAMERA POINTS AT ITS WORLD.
;DEFAULT PHYSICAL RASTER SIZE.
DEFINE MM{3.280833E-3}
DEFINE MICRON{3.280833E-6}
LAC[38.78]↔FMPR[MICRON]↔DAC 1(1) ;PDX.
LAC[40.00]↔FMPR[MICRON]↔DAC 2(1) ;PDY.
LAC[12.50]↔FMPR[MM]↔ DAC 3(1) ;FOCAL
LAC[XWD =288,=216]↔DAC 8(1) ;COLUMNS,,ROWS. ;LDX,,LDY
MOVN 3(1)↔FDVR 1(1)↔DAC -3(1) ;SCALEX ← -FOCAL/PDX
MOVN 3(1)↔FDVR 2(1)↔DAC -2(1) ;SCALEY ← -FOCAL/PDY
MOVN 3(1)↔FDVR 2(1)↔DAC -1(1) ;SCALEZ ← -FOCAL/PDZ
;CAMERA LOCUS AND ORIENTATION.
CALL(MKFRAME↑)
LAC[16.0]↔DAC ZWC(1) ;16 FEET ABOVE XY PLANE.
LAC 2,CAMERA↔FRAME. 1,2
;PLACE NEW CAMERA AT THE END OF THE WORLD'S CAMERA RING.
LAC 1,CAMERA
LAC 4,WORLD↔PCAMR 2,4 ;GET FIRST CAMERA OF THIS WORLD.
JUMPN 2,.+4
NCAMR. 1,4↔PCAMR. 1,4 ;INIT THE WORLD'S CAMERA RING.
POP1J
BRO 3,2
BRO. 1,2↔SIS. 2,1 ;RING-IN THE NEW CAMERA.
SIS. 1,3↔BRO. 3,1↔POP1J
ENDR MKCAMERA;3/12/73(BGB)-------------------------------------------
SUBR(MKWINDOW,CAMERA,WINDOW) ;MAKE AND LINK A WINDOW NODE.
COMMENT .------------------------------------------------------------
CAMERA argument may be zero;
Zero WINDOW argument will cause a new Display ring;
Otherwise new window placed into the display ring of the given window.
CALL(MKNODE,[$WINDOW]) ;WINDOW CREATION.
LAC[3.5]↔DAC -1(1) ;MAGNIFICATION.
LAC[XWD -=511,=511]↔DAC 1(1) ;XWD XL,,XH
LAC[XWD -=384,=384]↔DAC 2(1) ;XWD YL,,YH
LAC CAMERA↔NCAMR. 0,1 ;POINTER TO CAMERA.
BRO. 1,1↔SIS. 1,1 ;WINDOW RING.
CW. 1,1↔CCW. 1,1 ;DISPLAY RING.
;PLACE NEW WINDOW IN DISPLAY RING NEXT TO GIVEN WINDOW.
SKIPN 2,WINDOW↔GO L1
PVT 0,2↔AOS↔PVT. 0,1 ;INCREMENT SERIAL NUMBER.
SIS 3,2
SIS. 1,2↔BRO. 2,1
BRO. 1,3↔SIS. 3,1↔POP2J
;PLACE NEW WINDOW IN BRAND NEW DISPLAY RING, ALL BY ITSELF.
L1: AOS 3(1) ;SERIAL NUMBER #1.
LAC 4,UNIVERSE↔CCW 2,4 ;GET FIRST DISPLAY RING.
CW. 1,4↔CCW. 1,4 ;UPDATE UNIVERSE NODE.
JUMPE 2,POP2J. ;EXIT WHEN FIRST DISPLAY RING.
CW 3,2
CW. 1,2↔CCW. 2,1 ;RING-IN A NEW DISPLAY RING.
CCW. 1,3↔CW. 3,1
POP2J
ENDR MKWINDOW;3/12/73(BGB)-------------------------------------------
;FAIL MORE CORE.
IFE SAIL{
SUBR(MORCOR)
COMMENT .-----------------------------------------------------------.
;INITIALIZE THE UNIVERSE NODE WHEN NECESSARY.
SKIPE UNIVERSE↔GO L1 ;SKIP ON FIRST TIME ONLY.
SKIPE 1,OLD44↔CORE 1,↔JFCL ;CORE DOWN.
LAC 1,JOBREL↑↔DAC 1,OLD44 ;SAVE JOBREL.
SETZM REMAINDER
ADDI 1,4↔DAC 1,UNIVERSE
L1: LAC 1,UNIVERSE
MOVEI -1(1)↔DAC BLKCNT# ;POINTER TO NODES COUNTER.
MOVEI 1(1)↔DAC AVAIL# ;POINTER TO AVAIL LIST.
;FOUR MORE K.
LAC 1,JOBREL↔LAC JOBREL↔ADDI 10000
CORE↔FATAL<NO MORE CORE>
AOS 1↔SUB 1,REMAINDER
DAC 2,AC2#↔LAC 2,JOBREL
SETZM(1)↔HRLI(1)↔HRRI(1)1↔BLT(2)
MOVEI 2↔DAP @UNIVERSE ;UNIVERSE NODE IS TYPE #2.
;MAKE AVAIL LIST.
DIP 1,1↔ADD 1,[XWD NODSIZ+3,3] ;XWD NEXT,,THIS.
SKIPN@BLKCNT↔GO[
ADD 1,[XWD NODSIZ,NODSIZ] ;STEP OVER THE UNIVERSE NODE.
AOS@BLKCNT↔GO .+1] ;COUNT THE UNIVERSE NODE.
HRRZM 1,@AVAIL
L2: HLRZM 1,1(1)↔AOS(1) ;EMPTY LINK & EMPTY NODE TYPE #1.
ADD 1,[XWD NODSIZ,NODSIZ] ;ADVANCE ONE NODE.
CAILE 2,NODSIZ+NODSIZ-1-3(1) ;TEST FOR LAST NODE BUT ONE.
GO L2↔AOS(1)
;COMPUTE CORE REMAINDER.
SUBI 2,NODSIZ-1-3(1)↔DAC 2,REMAINDER
MOVEI 10000↔LAC 1,UNIVER↔ADDM -3(1) ;CORE SIZE.
LAC 1,@AVAIL↔LAC 2,AC2↔POP0J
ENDR MORCOR;4-DEC-72(BGB)
}
;SAIL MORE CORE.
IFN SAIL{
SUBR(MORCOR)------------------------------------------------------
ACCUMULATORS{PTR,SIZ}
;GET MORE CORE FROM SAIL - BGB - 8 MARCH 1972.
PUSH P,PTR↔PUSH P,SIZ↔SETZ PTR,
L1: MOVEI SIZ,NODSIZ*=400+1 ;AC3 SIZE OF SPACE.
CALL(CORGET↑) ;AC2 ADDRESS OF SPACE.
GO[FATAL(NO MORE CORE.)]↔SOS SIZ
MOVSI(PTR)↔HRRI 1(PTR)↔SETZM(PTR) ;CLEAR 4K BLOCK OF MEMORY.
BLT NODSIZ*=400-1(PTR) ;CLEAR 4K BLOCK OF MEMORY.
LAC 1,PTR ;-3 WORD OF FIRST NODE.
;INITIALIZE THE UNIVERSE WHEN NECESSARY.
SKIPE 2,UNIVER↔GO L3↔LAC 2,1
ADDI 2,3↔DAC 2,UNIVERSE ;POINTER TO UNIVERSE NODE.
MOVEI 2↔DAP @UNIVERSE ;UNIVERSE NODE IS TYPE #2.
L3: MOVEI -1(2)↔DAC BLKCNT# ;POINTER TO NODES COUNTER.
MOVEI 1(2)↔DAC AVAIL# ;POINTER TO AVAIL LIST.
;MAKE AVAIL LIST.
DIP 1,1↔ADD 1,[XWD NODSIZ+3,3] ;XWD NEXT,,THIS
SKIPN @BLKCNT↔GO[
ADD 1,[XWD NODSIZ,NODSIZ] ;STEP OVER UNIVERSE.
AOS @BLKCNT↔SUBI SIZ,NODSIZ↔GO .+1] ;COUNT UNIVERSE NODE.
SUBI SIZ,NODSIZ ;ALL BUT THE LAST.
HRRZM 1,@AVAIL ;FIRST AVAIL NODE.
;PLACE EACH NEW EMPTY BLOCK ON THE AVAIL LIST.
L2: HLRZM 1,1(1)↔AOS(1) ;EMPTY LIST POINTER & TYPE #1.
ADD 1,[XWD NODSIZ,NODSIZ]
SUBI SIZ,NODSIZ
JUMPG SIZ,L2↔AOS(1) ;LAST AVAIL NODE.
LAC 1,@AVAIL ;FIRST AVAIL NODE.
POP P,3↔POP P,2↔POP0J
ENDR MORCOR;------------------------------------------------------
}
SUBR(MKNODE,NODTYP) ;ALLOCATE A BLOCK OF NODSIZ WORDS.
COMMENT .-----------------------------------------------------------.
LAC 1,UNIVERSE↔AOS -1(1) ;COUNT OF NODES IN USE.
MOVEI 1,1(1)↔DAC 1,TMP1# ;POINTER TO AVAIL LIST.
SKIPN 1,0(1)↔CALL(MORCOR) ;EMPTY AVAIL LIST.
CDR 1(1)↔DAP @TMP1 ;NEXT AVAILABLE NODE.
SETZM 1(1) ;CLEAR THIS NODE.
LAC NODTYP↔DAC(1)↔POP1J ;PLACE NODE TYPE BITS.
ENDR MKNODE;2/22/74(BGB)---------------------------------------------
SUBR(KLNODE,NODE) ;RELEASE BLOCK OF NODSIZ WORDS.
COMMENT .-----------------------------------------------------------.
SKIPN 1,NODE↔POP1J ;WOULDN'T KILL NIL.
LAC(1)↔CAIN 0,1 ;TEST FOR EMPTY NODE.
GO[FATAL(KILLING EMPTY NODE.)] ;CAN'T KILL AN EMPTY.
HRLI -3(1)↔HRRI -2(1) ;CLEAR NODE.
SETZM -3(1)↔BLT 8(1)↔AOS(1) ;MARK NODE TYPE EMPTY-1.
LAC UNIVERSE↔SOS↔SOS@↔ADDI 2 ;COUNT OF NODES IN USE.
HRL 1,@↔HLRZM 1,1(1)↔HRRZM 1,@ ;CONS NODE INTO AVAIL LIST.
POP1J
ENDR KLNODE;2/22/74(BGB)---------------------------------------------
;TITLE IO - INPUT/OUTPUT - BGB - FEBRUARY 1973.
↓CMDCHN←←16
↓IODEND←20000
FILNAM:0 ;FILE NAME.
EXTION:0↔0 ;EXTENSION.
PPPN:0 ;PROJECT-PROGRAMMER.
STRING: 0 ;SAIL STRING BYTE POINTER.
STRCNT: -1 ;SAIL STRING CHAR COUNT.
OBUF:BLOCK 3 ;OUTPUT BUFFER HEADER.
IBUF:BLOCK 3 ;INPUT BUFFER HEADER.
IOBUF: BLOCK 2*(201+2)
CMDHDR: BLOCK 3 ;COMMAND BUFFER HEADER
CMDBUF: BLOCK 2*(201+2)
FILFLG↑:0 ;COMMAND FILE
EOF: 0 ;END OF FILE FLAG.
BLOCK 3
BFRAME:BLOCK 9 ;BODY FRAME BUFFER.
PCNT:0 ;PARTS COUNT.
FCNT:0 ;FACE COUNT.
ECNT:0 ;EDGE COUNT.
VCNT:0 ;VERTEX COUNT.
PLTFLG↑: 0 ;SET DURING PLOT OUTPUT TO DISABLE III KLUDGES
SUBN(WORDO,WORD) ;WORD OUTPUT.
COMMENT .-----------------------------------------------------------.
LAC WORD
SOSG OBUF+2↔OUT 1,0
GO[IDPB 0,OBUF+1↔POP1J]
FATAL(WORDO)
ENDR;2/18/73(BGB)----------------------------------------------------
WORDIN: ;----------------------------------------------------------
BEGIN WORDIN; WORD INPUT TO AC0 - BGB - 18 FEBRUARY 1973.
SOSG IBUF+2↔IN 1,0
GO[ILDB 0,IBUF+1↔POPJ P,]
STATO 1,1B22↔GO[FATAL(WORDIN)]
SETZ↔SETOM EOF↔POPJ P,
BEND;2/18/73(BGB)--------------------------------------------------
SUBR(PLOTO)SAISTR ;DISPLAY BUFFER TO DISK FILE.
COMMENT .-----------------------------------------------------------.
CALL(GETFIL,[SIXBIT/PLT/])↔POP0J
LAC 1,DPYBUF↑↔MOVN(1)1↔SUBI 2
CDR 2,(1)↔SETZM 1(2)
MOVS↔HRRI -1(1)↔DAC DUMLST
INIT 1,17↔SIXBIT/DSK/↔0↔HALT
ENTER 1,FILNAM↔GO .+4
OUT 1,DUMLST↔JFCL
RELEASE 1,↔POP0J
DUMLST: 0↔0
ENDR PLOTO;12/10/72(BGB)---------------------------------------------
SUBN(GETFIL,EXT) ;SETUP FILE SPEC FROM TTY LINE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{PTR,CNT}
SETZM FILNAM↔SETZM EXTION ;CLEAR FILNAME BLOCK.
SETZM EXTION+1↔SETZM PPPN
IFN SAIL{LAC 16,SAIL16↑↔POP 16,STRING ;SAIL STRING ARGUMENT.
POP 16,0↔HRRZM STRCNT↔DAC 16,SAIL16↑↔SKIPLE STRCNT↔GO L0}
IFN LISP{}
;TYPE OUT DEFAULT EXTENSION AND "FILE = ".
OUTCHR[9]↔LAC 1,EXT↔JUMPE 1,.+6
SETZ↔ROTC 6↔ADDI 40↔OUTCHR↔GO .-5
OUTSTR[ASCIZ/ FILE = /]
;FIRST CHARACTER.
L0: LAC PTR,[POINT 6,FILNAM,-1]
MOVEI CNT,6 ;BYTE PTR AND CHR COUNT.
CALL(GETCHL)↔DAC 1,0
CAIL "a"↔SUBI 40
CAIN 15↔GO[CALL(GETCHL)↔POP1J]↔AOSA(P) ;SKIP FILE NAME GIVEN.
;SCAN FOR FILENAME DELIMITERS.
L: CALL(GETCHL)↔DAC 1,0↔CAIL "a"↔SUBI 40
CAIN "."↔GO[SETZM EXT↔LAC PTR,[POINT 6,EXTION,-1]↔MOVEI CNT,3↔GO L]
CAIN "["↔GO[LAC PTR,[POINT 6,PPPN,-1]↔MOVEI CNT,3↔GO L]
CAIN ","↔GO[LAC PTR,[POINT 6,PPPN,17]↔MOVEI CNT,3↔GO L]
CAIN "]"↔GO L
CAIN 15↔GO EOL↔CAIN 12↔GO EOL ;END OF THE LINE.
JUMPE EOL+1 ;NULL CHARACTER - AT END OF SAIL STRINGS.
CAIG " "↔GO L ;IGNORE GARBAGE.
SOJL CNT,L
SUBI 40↔IDPB PTR↔GO L ;ASCII TO SIXBIT.
;RIGHT ADJUST SHORT PPPN'S.
EOL: CALL(GETCHL)↔CAR PPPN
TRNN 77↔LSH -6↔TRNN 77↔LSH -6 ;RIGHT ADJUST PROJECT.
DIP PPPN↔CDR PPPN
TRNN 77↔LSH -6↔TRNN 77↔LSH -6 ;RIGHT ADJUST PROGRAMMER.
DAP PPPN
SKIPN 1,EXTION↔LAC 1,EXT ;DEFAULT EXTENSION.
DAC 1,EXTION↔POP1J
ENDR GETFIL;2/18/73(BGB)---------------------------------------------
SUBR(GETCHW) ;GET CHARACTER WAIT.
COMMENT .-----------------------------------------------------------.
IFN SAIL{SKIPL STRCNT↔GO[SOSGE STRCNT↔TDCA 1,1↔ILDB 1,STRING↔POP0J]}
SKIPE FILFLG↔CALL(FILCHR)↔INCHRW 1↔POP0J
ENDR GETCHW;2/23/74(BGB)---------------------------------------------
SUBR(GETCHL)
COMMENT .-----------------------------------------------------------.
IFN SAIL{SKIPL STRCNT↔GO[SOSGE STRCNT↔TDCA 1,1↔ILDB 1,STRING↔POP0J]}
SKIPE FILFLG↔CALL(FILCHR)↔INCHWL 1↔POP0J
ENDR GETCHL;2/23/74(BGB)---------------------------------------------
SUBN(FILCHR) ;GET FILE CHARACTER & SKIP.
COMMENT .-----------------------------------------------------------.
SOSG CMDHDR+2↔IN CMDCHN,
GO[ILDB 1,CMDHDR+1↔JUMPE 1,FILCHR↔AOS(P)↔POP0J ]
STATO CMDCHN,IODEND↔FATAL(READ ERROR IN COMMAND FILE)
RELEASE CMDCHN,
SETZB 1,FILFLG↔POP0J
ENDR FILCHR;2/23/74(BGB)---------------------------------------------
END